home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1991: Code Warrior / bincue / Code Warrior.bin / Tools & Apps (Moof!) / Networking & Communications / The NetWork Project / Examples (Sources) / hello.p < prev    next >
Encoding:
Text File  |  1990-06-08  |  2.9 KB  |  119 lines  |  [TEXT/MPS ]

  1. program Hello;
  2. {     Copyright 1990 The NetWork Project, StatLab Heidelberg.   }
  3.  
  4. uses     MemTypes, QuickDraw, OSIntf, ToolIntf, SysEqu;
  5.  
  6.     PROCEDURE InitToolBox;
  7.     const callsToMoreMasters=10;
  8.         VAR
  9.             i : integer;
  10.             p : GrafPtr;
  11.             m : MenuHandle;
  12.             applZone:        THz;
  13.             oldMoreMast:    INTEGER;
  14.     
  15.     BEGIN
  16.         MaxApplZone;
  17.         
  18.     { Here is a trick - Stolen from MacApp- sugested by Jerome C. }
  19.         applZone := ApplicZone;
  20.         oldMoreMast := applZone^.moreMast;
  21.         applZone^.moreMast := oldMoreMast * callsToMoreMasters;
  22.         MoreMasters;
  23.         applZone^.moreMast := oldMoreMast;
  24.  
  25.         InitGraf(@thePort);                {initialize QuickDraw}
  26.         InitFonts;                           {initialize Font Manager}
  27.         InitWindows;                       {initialize Window Manager}
  28.         InitMenus;                           {initialize Menu Manager}
  29.         TEInit;                            {initialize TextEdit}
  30.         InitDialogs(NIL);                   {initialize Dialog Manager}
  31.         InitCursor;                        {call QuickDraw to make cursor (pointer) an arrow}
  32.  
  33.         m := GetMenu (1);
  34.         AddResMenu (m, 'DRVR');
  35.         InsertMenu (m, 0);
  36.         m := GetMenu (2); InsertMenu (m, 0);
  37.     END;
  38.  
  39. type RgnHPtr = ^RgnHandle; IntPtr = ^integer;
  40.  
  41. var savedgrayrgn, newgrayrgn, mousergn : RgnHandle; 
  42.     w : WindowPtr; pw : integer; ev : EventRecord;
  43.     mousepos : Point;
  44.     theDialog:DialogPtr;
  45.  
  46. PROCEDURE CenterRect(VAR GlobR : rect;vh:vhselect);
  47.     {Center a rectangle to center of screen}
  48. VAR    xdel, ydel,screenWidth,screenHeight: integer;
  49. BEGIN
  50.     with screenbits do 
  51.     begin 
  52.         screenwidth := bounds.right - bounds.left;
  53.         screenHeight := bounds.bottom - bounds.top;
  54.     end;
  55.     xdel:=0;ydel:=0;
  56.     WITH GlobR DO
  57.         if vh=h then xdel := ((screenWidth - (right - left)) DIV 2) - left
  58.         else ydel := ((screenHeight - (bottom - top)) DIV 2) - top;
  59.     offsetRect(GlobR, xdel, ydel);
  60. END;
  61.  
  62. PROCEDURE CenterWindow(wptr:windowptr;vh:vhselect);
  63.     {Center a window to center of screen}
  64. CONST
  65.     MakeFront = False;
  66. VAR
  67.     r, rbound : rect;
  68. BEGIN
  69.     if Wptr<>nil then begin
  70.         r := wptr^.portRect;
  71.         rbound := wptr^.portbits.bounds;
  72.         OffsetRect(r, -rbound.left, -rbound.top);
  73.         CenterRect(R,vh);
  74.         MoveWindow(wptr, r.left, r.top, MakeFront);
  75.     end;
  76. END;
  77.  
  78.  
  79. var tempAlert : AlertTHndl;
  80.     i:integer;
  81.     stoptime:longint;
  82. begin
  83.     InitToolBox;
  84.     drawmenubar;
  85.     
  86.     theDialog := GetNewDialog(130,nil,Pointer(-1));
  87.     if theDialog=nil then
  88.     begin {Fatal:could not process dialog}
  89.         sysbeep(2);
  90.     end
  91.     else begin
  92.         
  93.         CenterWindow(theDialog,h);
  94.         showwindow(theDialog);
  95.         selectwindow(theDialog);
  96.         setport(thedialog);
  97.         invalrect(thedialog^.portrect);
  98.         Beginupdate(theDialog);
  99.         drawdialog(theDialog);Endupdate(theDialog);
  100.     end;
  101.     
  102.     stoptime:=tickcount+60*10;
  103.     
  104.     repeat
  105.              
  106.         if WaitNextEvent (EveryEvent, ev, 60, mousergn) then 
  107.             case ev.what of
  108.                 updateEvt : begin
  109.                         
  110.                     end;
  111.                 diskEvt : if Point (ev.message).v <> noErr then
  112.                             if Eject (nil, Point (ev.message).h) <> noErr then;
  113.                         {     Eject bad disks . }
  114.             end;
  115.                       
  116.     until (ev.what in [keydown..autoKey, mousedown, diskEvt, app4Evt]) or (tickcount>stoptime);
  117.     
  118. end.
  119.